Personal Computer World 2006 May/PCWMAY06.iso/Software/Trial/ConceptDraw NetDiagrammer/data1.cab/Samples__Basic/Solutions/OrgChart/XMLBasedChart.cdb

Text File | 2006-02-08 | 8KB | 139 lines

'Два массива описывают расположение объектов в документе ConceptDraw, когда они представляют
'сотрудника некоторого уровня служебной иерархии. Размерность массива равна количеству уровней
'служебной иерархии.

'Определяются направления, по которым будут располагаться объекты в документе на этом уровне
'вложенности. Принимает одно из значений констант conbytAlone, conbytVertical, conbytHorizontal.
Dim aiDirection() As Integer
'Максимальное количество подчиненных у сотрудника на этом уровне вложенности
Dim aiMaxBranches() As Integer
'Верхняя граница этих массивов
Dim iStatUBound As Integer



'Группа массивов, содержащих данные о сотрудниках. Каждому сотруднику соответствуют данные
'с одинаковым индексом. Нулевой индекс соответствует фиктивному сотруднику самого верхнего уровня.
'Вводится для упрощения алгоритма. Реальные руководители самого верхнего уровня считаются подчиненными
'этого условного сотрудника.

'ID данного сотрудника в текстовой базе данных
Dim asID() As String
'ID непосредственного начальника данного сотрудника в текстовой базе данных
Dim asChiefID() As String
'ФИО сотрудника
Dim asName() As String
'Должность сотрудника
Dim asPost() As String
'Адрес электронной почты сотрудника
Dim asEMail() As String
'Дополнительная информация
Dim asCustom() As String
Dim iCustomCount As Integer
iCustomCount = 0
'Уровень вложенности объекта, представляющего сотрудника, в общей иерархии
Dim aiLevel() As Integer
'Ширина ветви, порождаемой данным сотрудником
Dim adBranchWidth() As Double
'Высота ветви, порождаемой данным сотрудником
Dim adBranchHeight() As Double
'Флаг, указывающий, что данный сотрудник порождает ветвь, которую следует изобразить на отдельной странице
Dim abNewPage() As Boolean
'Количество подчиненных у данного сотрудника
Dim asSubordCount() As Integer
'Двумерный массив. Для каждого сотрудника содержит индексы всех его подчиненных. Позволяет
'обрабатывать схему как древовидную структуру.
Dim asSubordinates() As Integer
'Верхняя граница этих массивов
Dim iUBound As Integer
'Верхняя граница второй размерности массива asSubordinates
Dim iUBound2 As Integer

'Название компании
Dim strOrgName As String

'Флаг, указывающий строится ли схема на единственной странице или на нескольких.
Dim bAllOnOnePage As Boolean

'Ширина и высота страницы документа в Units.
Dim intChartWidth As Integer
Dim intChartHeight As Integer

'Текстовый буфер, в который зачитываются символы из XML-файла
Dim strBuffer As String

Declare Sub BuildOrgChart(ByRef sOnOnePage As String)
Declare Sub RedimArrays(ByVal intUBound As Integer, ByVal intUBound2 As Integer)
Declare Function BuildOrgTreeFromXML(ByRef strTextFileName As String) As Boolean
Declare Function GetXMLTag(ByRef strTag As String, ByVal intFileNumber As Integer) As Integer
Declare Function GetXMLTextValue(ByRef strTag As String, ByVal intFileNumber As Integer) As Integer
Declare Sub ReplaceChr10And13(ByRef strText As String)
Declare Function ReReplaceSymbols(ByRef strText As String) As String
Declare Sub GetBranchStatistic(ByRef iPersonStart As Integer, ByVal intLevel As Integer)
Declare Sub SetBranchSize(ByRef iPersonStart As Integer, ByVal intLevel As Integer, ByRef dblReturnX As Double, ByRef dblReturnY As Double)
Declare Sub GetOrgStatistic()
Declare Sub IsBranchTooLarge(ByRef iPersonStart As Integer)
Declare Sub DrawChart()
Declare Sub DrawBranch(ByRef intPerson As Integer, ByVal lPage As Long, ByVal dblChiefShapeX As Double, ByVal dblChiefShapeY As Double, ByVal dblShapeX As Double, ByVal dblShapeY As Double, ByRef intReturnPersonLinkNextPages As Integer, ByRef bReturnPersonLinkNextPages As Boolean, ByRef intLinkToPage As Integer, ByVal workLib As Library)
Declare Sub DrawPersonData(ByVal intPerson As Integer, ByRef activePage As Page, ByVal dblShapeX As Double, ByVal dblShapeY As Double, ByVal intLinkToPage As Integer, ByVal workLib As Library)

#INCLUDE "consts.cdb"
#INCLUDE "drawFunctions.cdb"
#INCLUDE "loadXMLFunctions.cdb"

'========================================================================================================================
'========================================================================================================================

'Создание пользовательского меню. Автоматически вызывается при открытии документа из
'макроса уровня документа.
Sub CreateUserMenu()
    Dim custMenu As Menu
    Dim newMenuItem As MenuItem

    Set custMenu = thisDoc.CustomMenu
    custMenu.Caption = "&BuildOrgChart"
    custMenu.RemoveAll()

    Set newMenuItem = custMenu.AddMenuItem(0)
    newMenuItem.Caption = "All On A &One Page"
    newMenuItem.OnCmdArgs = "True"
    newMenuItem.SetCmdProcessing("BuildOrgChart")

    Set newMenuItem = custMenu.AddMenuItem(0)
    newMenuItem.Caption = "All On A &Few Page"
    newMenuItem.OnCmdArgs = "False"
    newMenuItem.SetCmdProcessing("BuildOrgChart")
End Sub

'========================================================================================================================
'========================================================================================================================

'Основная управляющая процедура.
Sub BuildOrgChart(ByRef sOnOnePage As String)
On Error GoTo ErrHandler
    Dim strXMLFileName As String
    If sOnOnePage = "True" Then
        bAllOnOnePage = True
    Else
        bAllOnOnePage = False
    End If

    'Получить имя XML-файла, описывающего структуру организации.
    strXMLFileName = GetOpenFileName(constrXMLFileExt, "CDBasic OrgChart XML Files")
    If strXMLFileName <> "" Then
    'Если имя получено, обрабатываем текст, зачитываем структуру организации и заполняем массивы данных.
        If BuildOrgTreeFromXML(strXMLFileName) Then
        'Если при зачитывании файлов не произошло ошибок, определяем статистику и параметры вывода диаграммы...
            GetOrgStatistic()
            '...и рисуем ее.
            DrawChart()
        End IF

    End If
    Exit Sub

ErrHandler:
    MsgBox ("In performing the macros, an error has occured.", cdbExclamation)

End Sub